
(defun c:ang ()
         (setvar "cmdecho"   0)
         (setq ang (rtos (* (/ (getangle "\nFirst point :") pi) 180.0) 2 2))
         (princ (strcat "\n" ang))
         (setvar "cmdecho"   1)
         (prin1)
)
(defun c:br  ()
         (setvar "cmdecho"   0)
             (verifylock )
             (setq names (list "LINE" "CIRCLE" "ARC" "POLYLINE")
                   texts "LINE,CIRCLE,ARC,POLYLINE")
             (verify ssobj names texts)
             (setq pt1 (getpoint "\nFirst  point : "))
             (setq pt2 (getpoint "\nSecond point : "))
             (action ssobj "break" pt1 pt2)
         (if(= s 1) (progn (setq s 0) (redraw (ssname sset 0) 4)))
         (setvar "cmdecho"   1)
         (setvar "blipmode"  1)
         (prin1)
)
(if (= ff nil)(princ "")(princ "\nACAD.lsp is loading  ."))
(defun c:chh ()
         (setvar "cmdecho"   0)
             (verifylock)
             (setq names (list "TEXT")
                   texts "TEXT" )
             (verify ssobj names texts)
             (if (/= 0 ssl) (chng "HEIGHT" 40))
         (if(= s 1) (progn (setq s 0) (redraw (ssname sset 0) 4)))
         (prin1)
)

(defun c:chl ()
         (setvar "cmdecho"   0)
             (verifylock )
             (if (/= 0 ssl) (chng "LAYER" 8))
         (if(= s 1) (progn (setq s 0) (redraw (ssname sset 0) 4)))
         (prin1)
)

(defun c:chlt()
         (setvar "cmdecho"   0)
             (verifylock )
             (if (/= 0 ssl) (chng "LTYPE" 6))
         (if(= s 1) (progn (setq s 0) (redraw (ssname sset 0) 4)))
         (prin1)
)

(defun c:chc ()
         (setvar "cmdecho"   0)
             (verifylock )
             (if (/= 0 ssl) (chng "COLOR" 62))
         (if(= s 1) (progn (setq s 0) (redraw (ssname sset 0) 4)))
         (prin1)
)

(defun c:chob()
         (setvar "cmdecho"   0)
             (verifylock )
             (setq names (list "TEXT")
                   texts "TEXT" )
             (verify ssobj names texts)
             (if (/= 0 ssl) (chng "OBLIQUING ANGLE" 51))
         (if(= s 1) (progn (setq s 0) (redraw (ssname sset 0) 4)))
         (prin1)
)
(princ ".")

(defun c:chs ()
         (setvar "cmdecho"   0)
             (verifylock )
             (setq names (list "TEXT")
                   texts "TEXT" )
             (verify ssobj names texts)
             (if (/= 0 ssl) (chng "STYLE" 7))
         (if(= s 1) (progn (setq s 0) (redraw (ssname sset 0) 4)))
         (prin1)
)

(defun c:cc  () (command "copy"  "c"      ))
(defun c:cl  () (command "copy"  "l"  ""  ))
(defun c:cp  () (command "copy"  "p"  ""  ))
(defun c:cw  () (command "copy"  "w"      ))

(defun err_er (s)                   ; If an error occurs
                                    ; while this command is active...
  (if (/= s "Function cancelled")
   (princ)
    (progn
     (princ "\nFunction cancelled by <Ctrl-C> ")
     (princ "\n     Good Luck .      ")
     (setvar "cmdecho" 1)
     (setvar "blipmode" 1)
     (prin1 )
    )
  )
  (if (/= err_oe nil)               ; If an old error routine exists
    (setq *error* err_oe)           ; then, reset it
  )
  (prin1)
)

(defun fars (stl)
         (setvar "cmdecho" 0)
         (if (/= (getvar "textstyle") stl)
                (command "style" stl stl "0" "" "" "y" "")
         )
         (if (= far nil)(load "farsi"))
         (princ "\n                     * I C O N   M E N U (Ver 1.04) *")
         (farsil)
         (setvar "cmdecho" 1)
    (prin1)
)

(defun c:di  ()
         (setq cl1 (getvar "clayer"))
             (if (= (tblsearch "layer" "dim" ) nil)
                 (command "layer" "m" "dim" "c" "1" "" "")
                 (setvar "clayer" "dim" )
             )
             (command "dim" )
         (prin1)
)

(defun c:ea  () (command "erase" "all" "" ))
(defun c:ec  () (command "erase" "c"      ))
(defun c:el  () (command "erase" "l"  ""  ))
(defun c:ep  () (command "erase" "p"  ""  ))
(defun c:ew  () (command "erase" "w"      ))

(defun c:fc  () (command "fillet" "c"     ))

(defun c:hom () (command "dim1" "hom"     ))
(princ ".")

(defun c:fl () (menucmd "I=flesh")(menucmd "I=*"))

(defun c:lal ()
         (setvar "cmdecho"   0)
         (setvar "blipmode"  0)
             (setq laobj (getstring "\nLayer name(s) to Lock: "   ))
             (if (= laobj "") (sela) )
             (if (= laobj "") (setq laobj (cdr (assoc 8 (entget(entlast))))))
             (setq laobj (strcase laobj))
             (command "layer" "lo" laobj "" )
             (princ (strcat "\nLayer " laobj " is locked now !"))
         (setvar "cmdecho"   1)
         (setvar "blipmode"  1)
         (prin1)
)
(defun c:las ()
         (setvar "cmdecho"   0)
         (setvar "blipmode"  0)
         (setq cl1 (getvar "clayer"))
             (setq laobj (getstring "\nNew current layer  : "   ))
             (if (= laobj "") (sela) )
             (if (= laobj "") (setq laobj (cdr (assoc 8 (entget(entlast))))))
             (setq laobj (strcase laobj))
             (command "layer" "s" laobj "" )
                    (princ (strcat "\nLayer " laobj " is set now !"))
         (setvar "cmdecho"   1)
         (setvar "blipmode"  1)
         (prin1)
)
(princ ".")
(defun c:lasf()
         (setvar "cmdecho"   0)
         (setvar "blipmode"  0)
         (setq cl1 (getvar "clayer"))
             (setq laobj (getstring "\nNew current layer  : "   ))
             (if (= laobj "") (sela) )
             (command "layer" "s" laobj "f" "*" "" )
         (setvar "cmdecho"   1)
         (setvar "blipmode"  1)
         (prin1)
)
(defun c:laf ()
    (setvar "cmdecho"   0)
    (setvar "blipmode"  0)
        (setq laobj (getstring "\nLayer name(s) to Freeze: "   ))
        (prin1)
        (if (= laobj "") (sela) )
          (if (/= laobj "")
             (progn
               (setq laobj (strcase laobj))
               (if (or (/= (tblsearch "layer" laobj) nil) (/= lobj "*"))
                 (progn
                   (if (/= (getvar "clayer") laobj)
                     (progn
                         (princ (strcat "\nLayer " laobj " is frozen now !"))
                         (command "layer" "f" laobj "" )
                         (setq laobjfz laobj )
                     )
                    (princ (strcat "\nLayer " laobj " is the CURRENT layer !"))
                   )
                 )
                 (princ(strcat "\nLayer " laobj " not found !"))
               )
             )
          )

         (setvar "cmdecho"   1)
         (setvar "blipmode"  1)
         (prin1)
)

(defun c:lau ()
         (setvar "cmdecho"   0)
         (setvar "blipmode"  0)
             (setq laobj (getstring "\nLayer name(s) to Unlock: "   ))
             (if (= laobj "") (sela) )
             (if (= laobj "") (setq laobj (cdr (assoc 8 (entget(entlast))))))
             (setq laobj (strcase laobj))
             (command "layer" "un" laobj "" )
             (princ (strcat "\nLayer " laobj " is unlocked now !"))
         (setvar "cmdecho"   1)
         (setvar "blipmode"  1)
         (prin1)
)
(princ ".")

(defun c:lam  ()
         (setvar "cmdecho"   0)
         (setq nln (getstring "\nNew layer name : "))
         (if (= "" (setq con (getstring "\nColor <white>: ")))(setq con "7"))
         (if (= "" (setq ltn (getstring "\nLinetype <Continuous>: ")))
           (setq ltn "continuous")
         )
         (command "layer"  "m" nln "c" con "" "lt" ltn "" "")
         (setvar "cmdecho"   1)
         (prin1)
)
(defun c:lan  ()
         (setvar "cmdecho"   0)
         (princ  "\nLayer name(s) to turn on: ")
                 (command "layer"  "on" pause ""   )
         (setvar "cmdecho"   1)
         (prin1)
)
(defun c:lat  ()
         (setvar "cmdecho"   0)
         (princ  "\nLayer name(s) to Thaw: " )
                 (command "layer"  "t" pause ""   )
         (setvar "cmdecho"   1)
         (prin1)
)
(defun c:lata () (command "layer"  "t"  "*"   ""   ))


(defun c:lisp()
 (if
     (= lspn nil )(setq lspn "ACAD" )
 )
 (setq lspname (getstring (strcat "\nEnter name of file <" lspn "> :")))
        (if (= lspname "")
                          (load lspn)
                          (progn
                                (load lspname)
                                (setq lspn lspname)
                          )
        )
 (setq lspn (strcase lspn))
 (prin1)
)

(princ ".")

(defun lispload (lisp lspid flesh)
         (if (= lspid nil)
             (progn
                    (if (not (load lisp nil))
                      (princ (strcat "\n" lisp ".lsp not found !"))
                      (runlisp lisp flesh)
                    )
             )
             (runlisp lisp flesh)
         )
    (prin1)
)

(defun runlisp (lisp flesh)
                    (cond
                          ((= lisp "ifn")(ifnlisp flesh))
                          ((= lisp "ics")(icslisp))
                          ((= lisp "ipn")(ipnlisp))
                          ((= lisp "fe2")(persia))
                          ((= lisp "ien")(ienlisp))
                          ((= lisp "idr")(idrlisp))
                    )
)

(defun c:mc  () (command "move"  "c"      ))
(defun c:ml  () (command "move"  "l"  ""  ))
(defun c:mp  () (command "move"  "p"  ""  ))
(defun c:mw  () (command "move"  "w"      ))

(defun c:mic () (command "mirror" "c"     ))
(defun c:mil () (command "mirror" "l"  "" ))
(defun c:mip () (command "mirror" "p"  "" ))
(defun c:miw () (command "mirror" "w"     ))

(defun c:ne  () (command "dim1" "new"     ))

(defun c:ose () (command "osnap" "endp"   ))
(defun c:osm () (command "osnap" "midp"   ))
(defun c:osn () (command "osnap" "none"   ))
(defun c:osnr() (command "osnap" "near"   ))
(defun c:osp () (command "osnap" "per"    ))

(defun c:pfw ()
             (setq pt1  (getpoint "\nFirst   point : "))
             (setq pt2  (getpoint "\nSecond  point : "))
             (setq pt3  (getpoint "\nThird   point : "))
             (setq pt4  (getpoint "\nFourth  point : "))
             (setq pt11 (getpoint "\nFifth   point : "))
             (setq pt21 (getpoint "\nSixth   point : "))
             (setq pt31 (getpoint "\nSeventh point : "))
             (setq pt41 (getpoint "\nEighth  point : "))

             (command "pface"
                pt1 pt2 pt3 pt4 pt11 pt21 pt31 pt41 ""
                -1 -2 -6 -5 ""
                -2 -3 -7 -6 ""
                -3 -4 -8 -7 ""
                -4 -1 -5 -8 ""  ""
             )
)

(defun c:pff () (command "pface" ))

(defun c:re  () (command "re-init" "16")(prin1))

(defun c:scl () (command "scale"  "l"     ))
(defun c:scp () (command "scale"  "p"     ))
(defun c:scc () (command "scale"  "c"     ))
(defun c:scw () (command "scale"  "w"     ))

(defun c:snr () (command "snap" "r" pause pause "snap" "off"))
(defun c:sn0 () (command "snap" "r" "" "0"      "snap" "off"))

(defun c:stc () (command "stretch" "c"    ))
(defun c:stw () (command "stretch" "w"    ))

(defun c:te  () (command "dim1" "te"      ))

(defun c:trl () (command "trim" "l" ""    ))

(defun c:ulaf() (command "layer" "t" laobjfz ""))
(defun c:ulas() (command "layer" "s" cl1 ""))

(defun c:un0 () (command "units" "" "0" "" "" "" "")(prin1))

(defun c:up  () (command "dim1" "up"      ))

(defun c:uof () (command "ucsicon" "off"  ))
(defun c:uon () (command "ucsicon" "on"   ))

(defun c:ur  ()
  (command "ucs" "" )
  (setq uang (getangle "\nRotation angle : "))
  (if (/= uang nil)
     (progn
         (setq uang (angtos uang 0 8))
         (command "ucs" "z" uang)
     )
     (progn
        (setq bas (entsel "\nSelect base object : "))
        (if (/= bas nil)
            (progn
                (setq e (car bas))
                (setq pt (cadr bas))
                        (if
                          (= (cdr (assoc 0 (entget e))) "LINE" )
                                (progn
                                      (setq pt  (osnap pt "nea"))
                                      (setq pt1 (osnap pt "end"))
                                      (setq uang (angtos (angle pt pt1) 0 8))
                                      (command "ucs" "z" uang)
                                )
                        )
            )
        )
     )
  )
(prin1)
)

(defun c:vr  () (command "view" "r"       ))
(defun c:vs  () (command "view" "s"       ))


(defun c:za  () (command "zoom"  "a"      ))
(defun c:zd  () (command "zoom"  "d"      ))
(defun c:ze  () (command "zoom"  "e"      ))
(defun c:zi  () (command "zoom"  ".75x"   ))
(defun c:zii () (command "zoom"  ".90x"   ))
(defun c:zp  () (command "zoom"  "p"      ))
(defun c:zw  () (command "zoom"  "w"      ))
(princ ".")
;
; Sub functions
;
(defun c:scr () (command "script"         ))

(defun sla ()
              (setq laobj (getstring "\nSelect Layer of entities :"))
              (if (= laobj "") (sela) )
              (setq sset(ssget "x" (list (cons 8 laobj))))
)
(defun sna ()
              (setq naobj (strcase (getstring "\nSelect Name of entities:")))
              (if (= naobj "") (sena) )
              (setq sset(ssget "x" (list (cons 0 naobj))))
)
(defun sco ()
              (setq coobj  (getint "\nSelect Color of entities:"))
              (if (= coobj nil) (seco) )
              (setq sset (ssget "x" (list (cons 62 coobj))))
              (if (= sset nil) (setq sset (ssadd)))
              (sslayer "color" coobj)
)
(defun slt ()
              (setq ltobj (strcase (getstring "\nSelect Ltype of entities:")))
              (if (= ltobj "") (selt) )
              (setq sset (ssget "x" (list (cons 6 ltobj))))
              (if (= sset nil) (setq sset (ssadd)))
              (setq sset1 (ssadd))
              (sslayer "ltype" ltobj )
)

(defun sslayer (ssnm ssn )
      (if (= ssnm "ltype" ) (setq ass 6) )
      (if (= ssnm "color" ) (setq ass 62))
      (setq fst (cdr (assoc 2 (tblnext "layer" t))))
      (setq sslist (list nil))
      (while (/= fst nil)
          (if (= (cdr (assoc ass (tblsearch "layer" fst))) ssn )
                 (setq sslist (cons fst sslist))
          )
          (setq fst (cdr (assoc 2 (tblnext "layer" ))))
      )
      (setq ssl (1- (length sslist)))
      (setq nmbr 1)
          (while (> ssl 0)
             (setq temp (nth (setq ssl (1- ssl)) sslist))
             (setq ssnew (ssget "x" (list (cons 8 temp) )))
             (if (/= ssnew nil)
                 (setq ssll (sslength ssnew))
                 (setq ssll 0)
             )
                 (while (> ssll 0)
                  (progn
                     (setq temp (ssname ssnew (setq ssll (- ssll 1.0))))
                     (if (= (assoc ass (entget temp)) nil)(ssadd temp sset))
                  )
                 )
          )
(setq sset1 sset)
)
(princ ".")


(defun setp (ntype)
 (setq setpsign 1)
 (setq obj (entsel "\nSelect base object :"))
   (if (/= obj nil)
     (progn
       (setq laobj (cdr (assoc 8 (entget(car obj)))))
       (if (/= (assoc ntype (entget(car obj))) nil)
           (setq entobj (cdr (assoc ntype (entget(car obj)))))
           (setq entobj (cdr (assoc ntype (tblsearch "layer" laobj))))
       )
     )
   )
)

(defun sela ()
 (setq obj (entsel "\nSelect base object :"))
   (if (/= obj nil)
       (setq laobj (cdr (assoc 8 (entget(car obj)))))
   )
)

(defun sena ()
 (setq obj (entsel "\nSelect base object :"))
   (if (/= obj nil)
       (setq naobj (cdr (assoc 0 (entget(car obj)))))
   )
)


(defun seco ()
 (setq obj (entsel "\nSelect base object :"))
   (if (/= obj nil)
     (progn
       (setq laobj (cdr (assoc 8 (entget(car obj)))))
       (setq coobj (cdr (assoc 62 (entget(car obj)))))
          (if (= coobj nil)
              (setq coobj (cdr (assoc 62 (tblsearch "layer" laobj))))
          )
     )
   )
)
(princ ".")

(defun selt ()
 (setq obj (entsel "\nSelect base object :"))
   (if (/= obj nil)
     (progn
       (setq laobj (cdr (assoc 8 (entget(car obj)))))
       (setq ltobj (cdr (assoc 6 (entget(car obj)))))
          (if (= ltobj nil)
              (setq ltobj (cdr (assoc 6 (tblsearch "layer" laobj))))
          )
     )
   )
)

;;;
;;; Verify and sort out entities from the selection set.
;;;
(defun verify (sset entver texts)
  (setq ssl   (sslength sset)
        nsset (ssadd) )
  (if (> ssl 25)
    (princ "\nVerifying the selected entities -- please wait. ")
  )
  (while (> ssl 0)
             (setq temp (ssname sset (setq ssl (1- ssl))))
             (if (member (cdr(assoc 0 (entget temp))) entver)
                 (ssadd temp nsset)
             )
  )
  (setq ssl (sslength nsset)
        ssobj nsset
        unctr 0
  )
  (print ssl)
  (princ (strcat texts " entities found. "))
)
(princ ".  ")
;;;
;;; Verify and sort out locked entities from the selection set.
;;;
(defun verifylock ()
         (setvar "blipmode"  0)
             (setq ssl 0)
             (setq sset (ssget))
         (if(= sset nil)
             (progn
                 (setq s 1)(setq sset (ssget "l"))(redraw (ssname sset 0) 3)
             )
         )
  (setq ssl   (sslength sset)
        nsset (ssadd))
  (while (> ssl 0)
    (setq temp (ssname sset (setq ssl (1- ssl))))
    (if (/=
            (cdr(assoc 70 (tblsearch "layer" (cdr (assoc 8 (entget temp))))))
             68
        )
      (ssadd temp nsset)
    )
  )
  (setq del (- (sslength sset) (sslength nsset)))
  (setq ssl (sslength nsset)
        ssobj nsset
        unctr 0
  )
  (print ssl)
  (princ " entities selected .")
  (print del)
  (princ " entities were on a locked leyer .")
)
;*******************************
(defun chng (type ntype)
 (setq setpsign 0)
 (command "undo" "group")
 (setq objent (cdr (assoc ntype (entget (ssname sset 0)))))
 (if (= objent nil)(setq objent
                        (cdr (assoc ntype (tblsearch "layer"
                                       (cdr (assoc 8 (entget(ssname sset 0))))
                                       )
                             )
                        )
                   )
 )
 (setq txt nil)
 (if (numberp objent)
         (progn
               (if (= ntype 51) (setq objent (/ (* objent 180) pi)) )
               (setq objent (rtos objent 2 1))
         )
         (setq txt t )
 )

 (if (= 1 ssl)
         (princ (strcat
                 "\nNew " type " <"
                 objent
                 ">"
                )
         )
   (princ (strcat "\nNew " type " for all of entities"))
 )
 (setq entobj (getstring ": "))
     (if (and (/= ntype 62)(/= ntype 51)(/= ntype 40))
         (setq tt (tblsearch type entobj))
         (setq tt 1)
     )
(if (or (= entobj "") tt)
 (progn
 (cond ((and (= ntype 62) (= (atoi entobj) 0))
          (setq coltxt entobj)
       )
       ((and (= ntype 62) (/= (atoi entobj) 0))
          (setq coltxt (atoi entobj))
       )
       ((and (/= ntype 62) (/= ntype 7)(/= ntype 8)(/= ntype 6)(/= entobj ""))
          (setq entobj (atof entobj) coltxt "")
       )
       (t
             (setq coltxt "")
       )
 )
     (if (or (= entobj "") (= entobj nil)) (setp ntype) )
     (if (or (= entobj "") (= entobj nil))
       ()
       (progn
          (if (and (= ntype 51) (= setpsign 0))
            (setq entobj (/ (* entobj pi) 180))
          )
          (setq hlt (getvar "highlight"))
          (setvar "highlight" 0)
          (while (> ssl 0)
            (setq temp (ssname ssobj (setq ssl (1- ssl))))
         (if(and (/= (assoc ntype (setq ent (entget temp))) nil)(= coltxt ""))
                (entmod (subst (cons ntype entobj)
                           (assoc ntype ent )
                           ent
                        )
                )
                (if (= coltxt "")
                    (entmod (cons (cons ntype entobj)
                                  ent
                            )
                    )
                    (command "chprop" temp "" "c" coltxt "")
                )
            )
          )
          (setq coltxt "")
          (if (numberp entobj)
                  (progn
                     (if (= ntype 51) (setq entobj (/ (* entobj 180) pi)) )
                     (setq entobj (rtos entobj 2 1))
                  )
          )
          (princ (strcat "\n "  (strcase entobj) " is the new " type " !"))
          (setvar "highlight" hlt)
       )
     )
 )
 (princ (strcat "\n "  type "  " (strcase entobj) "  not found !"))
)
     (command "undo" "end")
    (setvar "cmdecho"   1)
    (setvar "blipmode"  1)
)
;;;
;;; action
;;;
(defun action (sset cmd fst sec)
  (setq ssl   (sslength sset))
  (setq ssln  ssl)
  (while (> ssl 0)
    (setq temp (ssname sset (setq ssl (1- ssl))))
    (command cmd temp fst sec)
  )
; (print ssln)
; (princ (strcat " entities " cmd "ed ."))
)
;*******************************
(defun c:entg () (setq entt (entget (car (entsel)))))
(if (= ff nil)(setq ff 1)(princ "Completed."))
